home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / STRINGS.SWG / 0009_ST-CASE3.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  3KB  |  102 lines
  1. {
  2. Here's a few routines you might find useful For your name problem.
  3. I call the Function "UpperName" whenever the user presses a
  4. valid Text key in a name field, but it can also be called just
  5. once after the entire input String is entered.
  6. }
  7.  
  8. (* First, some general routines: *)
  9. (* ----------------------------- *)
  10.  
  11. Function  FindStrLength(S: String): Byte;
  12. { Finds "S"'s length, not counting trailing spaces }
  13. Var
  14.   StrLen: Byte Absolute S;
  15.   I     : Byte;
  16.  
  17. begin
  18.   I := StrLen;
  19.   if StrLen > 0 then
  20.     For I := StrLen downto 0 do
  21.       if S[I] <> ' ' then
  22.         Break;
  23.   FindStrLength := I;
  24. end; { FindStrLength }
  25.  
  26. Function WordDelimiter(C: Char): Boolean;
  27. { -Checks if "C" qualifies as a String Word-delimiter }
  28. Const
  29.   WordDels: Array[1..34] of Char =
  30.     #32#9#13#10#39',./?;:"<>[]{}-=\+|()*%@&^$#!~';
  31. Var
  32.   I: Integer;
  33.  
  34. begin
  35.   WordDelimiter := False;
  36.   For I := 1 to 34 do
  37.     if C = WordDels[I] then
  38.     begin
  39.       WordDelimiter := True;
  40.       Break;
  41.     end;
  42. end; { WordDelimiter }
  43.  
  44. Function  ParceWord(S: String; Ind, L: Integer): String;
  45. { Returns the next Word from "Ind" index in "S" }
  46. Var
  47.   I: Integer;
  48.  
  49. begin
  50.   ParceWord := '';
  51.   I := Ind;
  52.   For I := Ind to L do
  53.     if WordDelimiter(S[I+1]) then
  54.     begin
  55.       ParceWord := Copy(S, Ind, I-Ind+1);
  56.       Break;
  57.     end;
  58. end; { ParceWord }
  59.  
  60.  
  61. (* Now down to business: *)
  62. (* --------------------- *)
  63.  
  64. Procedure UpperName(Var S: String);
  65. { Converts the first Character in Words to upper Case letters }
  66. Var
  67.   I, L: Integer;
  68.   St  : String;
  69.  
  70. begin
  71.   L := FindStrLength(S);
  72.   if L = 0 then
  73.     Exit;
  74.   For I := L downto 2 do
  75.     if WordDelimiter(S[I-1]) then
  76.     begin
  77.       St := StUpCase(ParceWord(S, I, L));
  78.       { you can put in exception Words here... }
  79.       if (St = 'DE') or (St = 'DEN') then
  80.       { ie: Markis de Bleuchamp or van den Haag }
  81.          S[I] := 'd'
  82.       else
  83.         S[I] := UpCase(S[I]);
  84.     end;
  85.   S[1] := UpCase(S[1]);
  86. end; { UpperName }
  87.  
  88. {
  89. (The Function "StupCase" is from TurboPower Tpro, but any
  90. routine that converts a String to upper Case letters will do).
  91.  
  92. Please note that I had to modify this source beFore
  93. posting it here (it was full of norwegian name style
  94. identifiers that only would've confused you), so it's not
  95. tested in the current Form and may contain bugs.
  96. ...But I'm sure you get the general idea.  :-)
  97.  
  98. posting it here (it was full of norwegian name style
  99. identifiers that only would've confused you), so it's not
  100. tested in the current Form and may contain bugs.
  101. ...But I'm sure you get the general idea.  :-)
  102. }